home *** CD-ROM | disk | FTP | other *** search
/ Software Vault: The Gold Collection / Software Vault - The Gold Collection (American Databankers) (1993).ISO / cdr48 / pas_0593.zip / MYGRAPH.PAS < prev    next >
Pascal/Delphi Source File  |  1993-05-30  |  2KB  |  71 lines
  1. {─ Fido Pascal Conference ────────────────────────────────────────────── PASCAL ─
  2. Msg  : 436 of 457
  3. From : Chris Lukic                         1:271/29.0           27 May 93  18:42
  4. To   : William Sitch                       1:163/542.0
  5. Subj : Problems working with TP60...
  6. ────────────────────────────────────────────────────────────────────────────────
  7. I'm not sure where this code came from, but I'd be willing to bet
  8. it will be great deal of help.}
  9.    
  10.    
  11.  
  12.  Unit MyGraph;
  13.  
  14.  INTERFACE
  15.  Type
  16.   ColorValue = record Rvalue,Gvalue,Bvalue: byte; end;
  17.   PaleteType = array [0..255] of ColorValue;
  18.  
  19.  Procedure palette(tp:paletetype);
  20.  Procedure pset(x,y:Integer;c:Byte);
  21.  Function Point(x,y:Integer):byte;
  22.  Procedure RotatePalette(var p:Paletetype;n1,n2,d:Integer);
  23.  Procedure SetVga;
  24.  IMPLEMENTATION
  25.  
  26.    uses
  27.     Crt,Dos;
  28.  
  29.   
  30.  
  31.   var n,x,y,c:integer; ch: char; i: integer; p: PaleteType; image: file; ok:
  32. boolean;
  33.  
  34. procedure palette(tp:PaleteType);
  35.     var regs: Registers;
  36.   begin { procedure VGApalette }
  37.     with regs do
  38.       begin
  39.         AX:=$1012;
  40.         BX:=0; { first register to set }
  41.         CX:=256; { number of registers to set }
  42.         ES:=Seg(tp); DX:=Ofs(tp);
  43.       end;
  44.     Intr($10,regs);
  45.     end; { procedure SetVGApalette }
  46.  
  47.  procedure Pset(x,y: integer; c: byte);
  48.   begin { procedure PutPixel }
  49.     mem[$A000:word(320*y+x)]:=c;
  50.   end; { procedure PutPixel }
  51.  
  52.   function point(x,y: integer): byte;
  53.   begin { function GetPixel }
  54.     Point:=mem[$A000:word(320*y+x)];
  55.   end; { function GetPixel }
  56.  
  57.   procedure rotatePalette(var p:Paletetype;n1,n2,d: integer);
  58.     var
  59.       q: PaleteType;
  60.   begin { procedure rotatePalette }
  61.     q:=p;
  62.     for i:=n1 to n2 do
  63.       p[i]:=q[n1+(i+d) mod (n2-n1+1)];
  64.    palette(p);
  65.   end; { procedure rotatePalette }
  66.  
  67.   Procedure SetVga;
  68.   Begin
  69.        Inline($B8/$13/0/$CD/$10); 
  70.   End;
  71. END.